home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / cocktail / cg.lha / cg / src / c0.puma next >
Text File  |  1992-11-24  |  14KB  |  583 lines
  1. TRAFO GramC
  2. TREE Tree
  3. PUBLIC ParsSpec ScanSpec
  4.  
  5. GLOBAL {
  6.  
  7. FROM IO        IMPORT WriteS, WriteNl;
  8. FROM Strings    IMPORT tString, ArrayToString;
  9. FROM StringMem    IMPORT WriteString;
  10. FROM Idents    IMPORT NoIdent, tIdent, MakeIdent;
  11. FROM Texts    IMPORT WriteText;
  12. FROM Sets    IMPORT IsElement, Include;
  13. FROM TreeC2    IMPORT TreeIO;
  14.  
  15. FROM Tree    IMPORT
  16.    NoTree    , tTree        , Input        , Reverse    ,
  17.    Class    , NoClass    , Child        , Attribute    ,
  18.    ActionPart    , HasSelector    , HasAttributes    , NoCodeAttr    ,
  19.    Referenced    , Options    , TreeRoot    , QueryTree    ,
  20.    ClassCount    , iNoTree    , itTree    , Generated    ,
  21.    f        , WI, WE, WN    , ForallClasses    , ForallAttributes,
  22.    Nonterminal    , Terminal    , IdentifyAttribute,
  23.    String    , iPosition    ;
  24.  
  25. IMPORT Strings;
  26.  
  27. VAR
  28.    Node, ActClass, TheClass, TheAttr    : tTree;
  29.    iOper, iLeft, iRight, iNone, iPrec, iRule    : tIdent;
  30.    ActActionIndex, PrevActionIndex    : SHORTCARD;
  31.    IsImplicit                : BOOLEAN;
  32.    s                    : tString;
  33.  
  34. PROCEDURE GetBaseClass (Class: tTree): tTree;
  35.    BEGIN
  36.       WHILE Class^.Class.BaseClass^.Kind # NoClass DO
  37.      Class := Class^.Class.BaseClass;
  38.       END;
  39.       RETURN Class;
  40.    END GetBaseClass;
  41.  
  42. PROCEDURE IsLast (Class, Action: tTree): BOOLEAN;
  43.    VAR Found, Last: BOOLEAN;
  44.    BEGIN
  45.       IsLast2 (Class, Action, Found, Last);
  46.       RETURN Last;
  47.    END IsLast;
  48.  
  49. PROCEDURE IsLast2 (t, Action: tTree; VAR pFound, pLast: BOOLEAN);
  50.    VAR Found, Last: BOOLEAN;
  51.    BEGIN
  52.       CASE t^.Kind OF
  53.       | Class:
  54.         IsLast2 (t^.Class.Attributes, Action, pFound, pLast);
  55.         IF pFound OR NOT pLast THEN RETURN; END;
  56.         IsLast2 (t^.Class.BaseClass, Action, pFound, pLast);
  57.       | Child:
  58.         IsLast2 (t^.Child.Next, Action, Found, Last);
  59.         pFound := Found;
  60.         IF Found THEN
  61.            pLast := Last;
  62.         ELSE
  63.            pLast := FALSE;
  64.         END;
  65.       | Attribute:
  66.         IsLast2 (t^.Attribute.Next, Action, pFound, pLast);
  67.       | ActionPart:
  68.         IsLast2 (t^.ActionPart.Next, Action, Found, Last);
  69.         pFound := Found OR (Action = t);
  70.         IF Found THEN
  71.            pLast := Last;
  72.         ELSE
  73.            pLast := Last AND (Action = t);
  74.         END;
  75.       ELSE
  76.         pFound := FALSE;
  77.         pLast  := TRUE;
  78.       END;
  79.    END IsLast2;
  80.  
  81. PROCEDURE Prefix;
  82.    BEGIN
  83.       IF TreeRoot^.Ag.ScannerName # NoIdent THEN WI (TreeRoot^.Ag.ScannerName); !_! END;
  84.    END Prefix;
  85. }
  86.  
  87. BEGIN {
  88.    ArrayToString ("OPER"    , s); iOper    := MakeIdent (s);
  89.    ArrayToString ("RIGHT"    , s); iRight    := MakeIdent (s);
  90.    ArrayToString ("LEFT"    , s); iLeft    := MakeIdent (s);
  91.    ArrayToString ("NONE"    , s); iNone    := MakeIdent (s);
  92.    ArrayToString ("PREC"    , s); iPrec    := MakeIdent (s);
  93.    ArrayToString ("RULE"    , s); iRule    := MakeIdent (s);
  94. }
  95.  
  96. PROCEDURE ParsSpec (t: Tree)
  97.  
  98. Ag (..) :- {
  99.     IF ScannerName # NoIdent THEN
  100.        !SCANNER ! WI (ScannerName);
  101.     END;
  102.     ! PARSER ! WI (ParserName); !!
  103.     !GLOBAL {!
  104.     WriteText (f, ParserCodes^.Codes.Global);
  105.     Node := Modules;
  106.     WHILE Node^.Kind = Tree.Module DO
  107.        WriteText (f, Node^.Module.ParserCodes^.Codes.Global);
  108.        Node := Node^.Module.Next;
  109.     END;
  110.         ParsVariant (Classes);
  111.     !!
  112.     !typedef union {!
  113.     ! ! Prefix; !tScanAttribute Scan;!
  114.     Node := Classes;
  115.     WHILE Node^.Kind = Class DO
  116.       WITH Node^.Class DO
  117.          IF {Nonterminal, Referenced, HasAttributes} <= Properties THEN
  118.            IF (String IN Properties) AND NOT (HasSelector IN Properties) THEN
  119.          ! yy! WN (Name); ! /* ! WE (Name); ! */ yy! WN (Name); !;!
  120.            ELSE
  121.          ! yy! WI (Selector); ! ! WI (Selector); !;!
  122.            END;
  123.          END;
  124.          Node := Next;
  125.       END;
  126.     END;
  127.     !} tParsAttribute;!
  128.     !}!
  129.     !!
  130.     !EXPORT {!
  131.     WriteText (f, ParserCodes^.Codes.Export);
  132.     Node := Modules;
  133.     WHILE Node^.Kind = Tree.Module DO
  134.       WriteText (f, Node^.Module.ParserCodes^.Codes.Export);
  135.       Node := Node^.Module.Next;
  136.     END;
  137.     !}!
  138.     !!
  139.     !LOCAL {!
  140.     WriteText (f, ParserCodes^.Codes.Local);
  141.     Node := Modules;
  142.     WHILE Node^.Kind = Tree.Module DO
  143.       WriteText (f, Node^.Module.ParserCodes^.Codes.Local);
  144.       Node := Node^.Module.Next;
  145.     END;
  146.     !}!
  147.     !!
  148.     !BEGIN {!
  149.     WriteText (f, ParserCodes^.Codes.Begin);
  150.     Node := Modules;
  151.     WHILE Node^.Kind = Tree.Module DO
  152.       WriteText (f, Node^.Module.ParserCodes^.Codes.Begin);
  153.       Node := Node^.Module.Next;
  154.     END;
  155.     !}!
  156.     !!
  157.     !CLOSE {!
  158.     WriteText (f, ParserCodes^.Codes.Close);
  159.     Node := Modules;
  160.     WHILE Node^.Kind = Tree.Module DO
  161.       WriteText (f, Node^.Module.ParserCodes^.Codes.Close);
  162.       Node := Node^.Module.Next;
  163.     END;
  164.     !}!
  165.     !!
  166.     !TOKEN!
  167.     !!
  168.     ForallClasses (Classes, Token);
  169.     !!
  170.     !OPER!
  171.     !!
  172.     PrecDefs (Precs);
  173.     !!
  174.     !RULE!
  175.     !!
  176.     ForallClasses (Classes, ParsSpec);
  177. }; .
  178. Class (..) :- {
  179.     IF {Nonterminal, Referenced} <= Properties THEN
  180.        TheClass := t;
  181.        Grammar (t);
  182.     END;
  183. }; .
  184.  
  185.  
  186. PROCEDURE ScanSpec (t: Tree)
  187.  
  188. Ag (..) :- {
  189.     !c!
  190.     !# if defined __STDC__ | defined __cplusplus!
  191.     !# define ARGS(parameters)    parameters!
  192.     !# else!
  193.     !# define ARGS(parameters)    ()!
  194.     !# endif!
  195.     !!
  196.     ForallClasses (Classes, ScanVariant);
  197.     !!
  198.     !typedef union {!
  199.     ! tPosition Position;!
  200.     ForallClasses (Classes, ScanAttr);
  201.     !} ! Prefix; !tScanAttribute;!
  202.     !!
  203.     !extern void ! Prefix; !ErrorAttribute ARGS((int Token, ! Prefix; !tScanAttribute * pAttribute));!
  204.     !%%!
  205.     !void ! Prefix; !ErrorAttribute!
  206.     !# if defined __STDC__ | defined __cplusplus!
  207.     ! (int Token, ! Prefix; !tScanAttribute * pAttribute)!
  208.     !# else!
  209.     ! (Token, pAttribute) int Token; ! Prefix; !tScanAttribute * pAttribute;!
  210.     !# endif!
  211.     !{!
  212.     ! pAttribute->Position = ! Prefix; !Attribute.Position;!
  213.     ! switch (Token) {!
  214.     ForallClasses (Classes, ErrorActions);
  215.     ! }!
  216.     !}!
  217.     !%%!
  218.     ForallClasses (Classes, ScanSpec);
  219. }; .
  220. Class (..) :- {
  221.     IF {Terminal, Referenced} <= Properties THEN
  222.        WN (Code);
  223.        IF HasAttributes IN Properties THEN    ! S ! 
  224.        ELSE                    ! N ! 
  225.        END;
  226.        IF (String IN Properties) AND NOT (HasSelector IN Properties) THEN
  227.           !yy! WN (Code);
  228.        ELSE
  229.           WI (Selector);
  230.        END;
  231.        ! ! WI (Name); !!
  232.     END;
  233. }; .
  234.  
  235.  
  236. PROCEDURE ErrorActions (t: Tree)
  237.  
  238. Class (..) :- {
  239.     IF {Terminal, Referenced, HasAttributes} <= Properties THEN
  240.       ! case /* ! WE (Name); ! */ ! WN (Code); !: !
  241.       TheClass := t;
  242.       ForallAttributes (t, ErrorActions);
  243.       ! break;!
  244.     END;
  245. }; .
  246. ActionPart (..) :- {
  247.     ErrorActions (Actions);
  248. }; .
  249. Assign (..) :- {
  250.     ErrorActions (Results); !=! ErrorActions (Arguments); !;!
  251.     ErrorActions (Next);
  252. }; .
  253. Copy (..) :- {
  254.     ErrorActions (Results); ! = ! ErrorActions (Arguments); !;!
  255.     ErrorActions (Next);
  256. }; .
  257. TargetCode (..) :- {
  258.     ErrorActions (Code); !;!
  259.     ErrorActions (Next);
  260. }; .
  261. Order (..) :- {
  262.     ErrorActions (Next);
  263. }; .
  264. Check (..) :- {
  265.     IF Statement # NoTree THEN
  266.        IF Condition # NoTree THEN
  267.           !if (! ErrorActions (Condition); !) ; else { ! ErrorActions (Statement); !; }!
  268.        ELSE
  269.           !{ ! ErrorActions (Statement); !; }!
  270.        END;
  271.     ELSE
  272.        !(void) (! ErrorActions (Condition); !);!
  273.     END;
  274.     ErrorActions (Next);
  275. }; .
  276. Designator (..) :- {
  277.     WI (Selector); !:! WI (Attribute);
  278.     ErrorActions (Next);
  279. }; .
  280. Ident (..) :- {
  281.     TheAttr := IdentifyAttribute (TheClass, Attribute);
  282.     IF TheAttr # NoTree THEN
  283.        !pAttribute->! 
  284.        IF Attribute = iPosition THEN
  285.            ELSIF (String IN TheClass^.Class.Properties) AND NOT (HasSelector IN TheClass^.Class.Properties) THEN
  286.           !yy! WN (TheClass^.Class.Code); !.! 
  287.        ELSE
  288.           WI (TheClass^.Class.Selector); !.! 
  289.        END;
  290.     END;
  291.     WI (Attribute);
  292.     ErrorActions (Next);
  293. }; .
  294. Any (..) :- {
  295.     WriteString (f, Code);
  296.     ErrorActions (Next);
  297. }; .
  298. Anys (..) :- {
  299.     ErrorActions (Layouts);
  300.     ErrorActions (Next);
  301. }; .
  302. LayoutAny (..) :- {
  303.     WriteString (f, Code);
  304.     ErrorActions (Next);
  305. }; .
  306.  
  307.  
  308. PROCEDURE ScanVariant (t: Tree)
  309.  
  310. Class (..) :- {
  311.     IF {Terminal, Referenced, HasAttributes} <= Properties THEN
  312.       !typedef struct { tPosition yyPos; ! 
  313.       TheClass := t;
  314.       ForallAttributes (t, RecordField);
  315.           IF (String IN Properties) AND NOT (HasSelector IN Properties) THEN
  316.         !} /* ! WE (Name); ! */ yy! WN (Code); !;!
  317.       ELSE
  318.         !} yy! WI (Selector); !;!
  319.       END;
  320.     END;
  321. }; .
  322.  
  323.  
  324. PROCEDURE ScanAttr (t: Tree)
  325.  
  326. Class (..) :- {
  327.     IF {Terminal, Referenced, HasAttributes} <= Properties THEN
  328.           IF (String IN Properties) AND NOT (HasSelector IN Properties) THEN
  329.         ! yy! WN (Code); ! /* ! WE (Name); ! */ yy! WN (Code); !;!
  330.       ELSE
  331.         ! yy! WI (Selector); ! ! WI (Selector); !;!
  332.       END;
  333.     END;
  334. }; .
  335.  
  336.  
  337. PROCEDURE ParsVariant (t: Tree)
  338.  
  339. Class (..) :- {
  340.     IF {Nonterminal, Referenced, HasAttributes} <= Properties THEN
  341.       !typedef struct { ! 
  342.       TheClass := t;
  343.       ForallAttributes (Attributes, RecordField);
  344.       GenExt (Extensions);
  345.           IF (String IN Properties) AND NOT (HasSelector IN Properties) THEN
  346.         !} /* ! WE (Name); ! */ yy! WN (Name); !;!
  347.       ELSE
  348.         !} yy! WI (Selector); !;!
  349.       END;
  350.     END;
  351.     ParsVariant (Next);
  352. }; .
  353.  
  354.  
  355. PROCEDURE GenExt (t: Tree)
  356.  
  357. Class (..) :- {
  358.     ForallAttributes (Attributes, RecordField);
  359.     GenExt (Extensions);
  360.     GenExt (Next);
  361. }; .
  362.  
  363.  
  364. PROCEDURE Token (t: Tree)
  365.  
  366. Class (..) :- {
  367.     IF {Terminal, Referenced} <= Properties THEN
  368.        WriteName (Name); ! = ! WN (Code); !!
  369.     END;
  370. }; .
  371.  
  372.  
  373. PROCEDURE RecordField    /* TheClass    */ (t: Tree)
  374.  
  375. Attribute (..) :- {
  376.     IF (NoCodeAttr * Properties) = {} THEN 
  377.        IF (Nonterminal IN TheClass^.Class.Properties) OR (Name # iPosition) THEN
  378.           WI (Type); ! ! WI (Name); !; ! 
  379.        END;
  380.     END;
  381. }; .
  382.  
  383.  
  384. PROCEDURE PrecDefs (t: Tree)
  385.  
  386. LeftAssoc (..) :- {
  387.     !LEFT ! PrecDefs (Names); !!
  388.     PrecDefs (Next);
  389. }; .
  390. RightAssoc (..) :- {
  391.     !RIGHT! PrecDefs (Names); !!
  392.     PrecDefs (Next);
  393. }; .
  394. NonAssoc (..) :- {
  395.     !NONE ! PrecDefs (Names); !!
  396.     PrecDefs (Next);
  397. }; .
  398. Name (..) :- {
  399.     ! ! WI (Name);
  400.     PrecDefs (Next);
  401. }; .
  402.  
  403.  
  404. PROCEDURE Grammar (t: Tree)
  405.  
  406. Class (..) :- {
  407.     IF Extensions^.Kind = Tree.NoClass THEN        (* Low ? *)
  408.        WITH TheClass^.Class DO
  409.           IF String IN Properties THEN !yy! WN (Name); ELSE WriteName (Name); END;
  410.        END;
  411.        ! : ! 
  412.        ActClass := t;
  413.        PrevActionIndex := 0;
  414.        IsImplicit := FALSE;
  415.        ForallAttributes (t, Rule);
  416.        IF Prec # NoIdent THEN !PREC ! WI (Prec); ! ! END;
  417.        !.!
  418.        PrevActionIndex := 0;
  419.        IsImplicit := TRUE;
  420.        ForallAttributes (t, Implicit);
  421.     ELSE
  422.        Rule (Extensions);
  423.     END;
  424. }; .
  425.  
  426.  
  427. PROCEDURE Rule (t: Tree)
  428.  
  429. Class (..) :- {
  430.     Grammar (t);
  431.     Rule (Next);
  432. }; .
  433. Child (..) :- {
  434.     IF {String, Nonterminal} <= Class^.Class.Properties THEN !yy! WN (Type); ELSE WriteName (Type); END; ! ! 
  435. }; .
  436. ActionPart (..) :- {
  437.     IF IsLast (ActClass, t) THEN
  438.        !{! 
  439.        IF PrevActionIndex # 0 THEN
  440.           Node := GetBaseClass (TheClass);
  441.           WITH Node^.Class DO
  442.          IF HasAttributes IN Properties THEN
  443.             ! $$.! 
  444.             IF String IN Properties THEN !yy! WN (Name); ELSE WI (Name); END;
  445.             ! = $! WN (PrevActionIndex); !.! 
  446.             IF String IN Properties THEN !yy! WN (Name); ELSE WI (Name); END;
  447.             !;!
  448.          END;
  449.           END;
  450.        END;
  451.        Rule (Actions);
  452.        !} ! 
  453.     ELSE
  454.        !xx! WN (Name); ! ! 
  455.     END;
  456.     PrevActionIndex := ParsIndex;
  457. }; .
  458. Assign (..) :- {
  459.     Rule (Results); !=! Rule (Arguments); !;!
  460.     Rule (Next);
  461. }; .
  462. Copy (..) :- {
  463.     Rule (Results); ! = ! Rule (Arguments); !;!
  464.     Rule (Next);
  465. }; .
  466. TargetCode (..) :- {
  467.     Rule (Code); !;!
  468.     Rule (Next);
  469. }; .
  470. Order (..) :- {
  471.     Rule (Next);
  472. }; .
  473. Check (..) :- {
  474.     IF Statement # NoTree THEN
  475.        IF Condition # NoTree THEN
  476.           !if (! Rule (Condition); !) ; else { ! Rule (Statement); !; }!
  477.        ELSE
  478.           !{ ! Rule (Statement); !; }! 
  479.        END;
  480.     ELSE
  481.        !(void) (! Rule (Condition); !);!
  482.     END;
  483.     Rule (Next);
  484. }; .
  485. Designator (..) :- {
  486.     TheAttr := IdentifyAttribute (ActClass, Selector);
  487.     IF TheAttr # NoTree THEN
  488.       Node := TheAttr^.Child.Class;
  489.       IF Node # NoTree THEN
  490.         !$! 
  491.         IF NOT IsImplicit THEN
  492.            WN (TheAttr^.Child.ParsIndex);
  493.         ELSE
  494.            WN (SHORTINT (TheAttr^.Child.ParsIndex + 1 - ActActionIndex));
  495.         END;
  496.         IF Nonterminal IN Node^.Class.Properties THEN    (* nonterminal *)
  497.           Node := GetBaseClass (Node);
  498.           IF (String IN Node^.Class.Properties) AND NOT (HasSelector IN Node^.Class.Properties) THEN
  499.             !.yy! WN (Node^.Class.Name);
  500.           ELSE
  501.             !.! WI (Node^.Class.Name);
  502.           END;
  503.         ELSE                        (* terminal *)
  504.           !.Scan! 
  505.           IF Attribute = iPosition THEN
  506.           ELSIF (String IN Node^.Class.Properties) AND NOT (HasSelector IN Node^.Class.Properties) THEN
  507.             !.yy! WN (Node^.Class.Code);
  508.           ELSE
  509.             !.! WI (Node^.Class.Selector);
  510.           END;
  511.         END;
  512.         !.! WI (Attribute);
  513.       ELSE
  514.         WI (Selector); !:! WI (Attribute);
  515.       END;
  516.     ELSE
  517.       WI (Selector); !:! WI (Attribute);
  518.     END;
  519.     Rule (Next);
  520. }; .
  521. Ident (..) :- {
  522.     TheAttr := IdentifyAttribute (ActClass, Attribute);
  523.     Node := GetBaseClass (TheClass);
  524.     IF TheAttr # NoTree THEN
  525.       IF (String IN Node^.Class.Properties) AND NOT (HasSelector IN Node^.Class.Properties) THEN
  526.         !$$.yy! WN (Node^.Class.Name); !.! WI (Attribute);
  527.       ELSE
  528.         !$$.! WI (Node^.Class.Name); !.! WI (Attribute);
  529.       END;
  530.     ELSE
  531.       WI (Attribute);
  532.     END;
  533.     Rule (Next);
  534. }; .
  535. Any (..) :- {
  536.     WriteString (f, Code);
  537.     Rule (Next);
  538. }; .
  539. Anys (..) :- {
  540.     Rule (Layouts);
  541.     Rule (Next);
  542. }; .
  543. LayoutAny (..) :- {
  544.     WriteString (f, Code);
  545.     Rule (Next);
  546. }; .
  547.  
  548.  
  549. PROCEDURE Implicit (t: Tree)
  550.  
  551. ActionPart (..) :- {
  552.     IF NOT (Generated IN Properties) AND NOT IsLast (ActClass, t) THEN
  553.        INCL (Properties, Generated);
  554.        ActActionIndex := ParsIndex;
  555.        !xx! WN (Name); ! : {! 
  556.        IF PrevActionIndex # 0 THEN
  557.           Node := GetBaseClass (TheClass);
  558.           WITH Node^.Class DO
  559.          IF HasAttributes IN Properties THEN
  560.             ! $$.! 
  561.             IF String IN Properties THEN !yy! WN (Name); ELSE WI (Name); END;
  562.             ! = $! WN (SHORTINT (PrevActionIndex + 1 - ActActionIndex)); !.! 
  563.             IF String IN Properties THEN !yy! WN (Name); ELSE WI (Name); END;
  564.             !;!
  565.          END;
  566.           END;
  567.        END;
  568.        Rule (Actions);
  569.        !} .!
  570.     END;
  571.     PrevActionIndex := ParsIndex;
  572. }; .
  573.  
  574. PROCEDURE WriteName (Name: tIdent)
  575.  
  576. (iOper);
  577. (iLeft);
  578. (iRight);
  579. (iNone);
  580. (iPrec);
  581. (iRule)    :-    !\! WI (Name); .
  582. _    :-        WI (Name); .
  583.